home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue45 / DCOM / CreateCOMObj / CreateRem.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-05-11  |  2.0 KB  |  66 lines
  1. unit CreateRem;
  2.  
  3. interface
  4. uses ActiveX;
  5.  
  6. function CreateRemComObject(const MachineName: WideString;
  7.   const ClassID,InterFaceID: TGUID) : IUnknown;
  8. implementation
  9.  
  10. uses Windows,Sysutils,ComObj,DCOMSecUtils;
  11.  
  12. type
  13.   TCoCreateInstanceExProc = function(const clsid: TCLSID;
  14.     unkOuter: IUnknown; dwClsCtx: Longint; ServerInfo: PCoServerInfo;
  15.     dwCount: Longint; rgmqResults: PMultiQIArray): HResult stdcall;
  16.  
  17. var
  18.   CoCreateInstanceEx: TCoCreateInstanceExProc = nil;
  19.  
  20.  
  21. function CreateRemComObject(const MachineName: WideString;
  22.   const ClassID,InterFaceID: TGUID) : IUnknown;
  23. const
  24.   LocalFlags = CLSCTX_LOCAL_SERVER or CLSCTX_REMOTE_SERVER or CLSCTX_INPROC_SERVER;
  25.   RemoteFlags = CLSCTX_REMOTE_SERVER;
  26. var
  27.   MQI: TMultiQI;
  28.   ServerInfo: TCoServerInfo;
  29.   Flags, Size: DWORD;
  30.   Ole32: HModule;
  31.   LocalMachine: array [0..MAX_COMPUTERNAME_LENGTH] of char;
  32.   CoAuthInfo : TCoAuthInfo;
  33.   COAUTHID : TCOAUTHIDENTITY;
  34. begin
  35.  if @CoCreateInstanceEx = nil then
  36.   begin
  37.     Ole32 := GetModuleHandle('ole32.dll');
  38.     Win32Check(Ole32 > HINSTANCE_ERROR);
  39.     @CoCreateInstanceEx := GetProcAddress(Ole32, 'CoCreateInstanceEx');
  40.     if @CoCreateInstanceEx = nil then
  41.          raise Exception.Create('DCOM is not installed');
  42.   end;
  43.  
  44.   FillChar(ServerInfo, sizeof(ServerInfo), 0);
  45.   ServerInfo.pwszName := PWideChar(MachineName);
  46.   MQI.IID         := @InterFaceID;
  47.   MQI.itf := nil;
  48.   MQI.hr  := 0;
  49.   { If a MachineName is specified check to see if it the local machine.
  50.     If it isn't, do not allow LocalServers to be used. }
  51.   if Length(MachineName) > 0 then
  52.   begin
  53.     Size := Sizeof(LocalMachine);  // Win95 is hypersensitive to size
  54.     if GetComputerName(LocalMachine, Size) and
  55.        (AnsiCompareText(LocalMachine, MachineName) = 0) then
  56.       Flags := LocalFlags else
  57.       Flags := RemoteFlags;
  58.   end else
  59.     Flags := LocalFlags;
  60.   OleCheck(CoCreateInstanceEx(ClassID, nil, Flags, @ServerInfo, 1, @MQI));
  61.   OleCheck(MQI.HR);
  62.   Result := MQI.itf;
  63. end;
  64.  
  65. end.
  66.